home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 41.zip / BS1 part 41 / Lattice C v5.02 d4.adf / examples / debugger / showcli.cpr < prev    next >
Text File  |  1988-11-07  |  4KB  |  144 lines
  1. /* 
  2. Usage: ShowCLI [ <command> | 0xnnnnnn | n] 
  3. Version 1.00  02-Nov-88
  4.  
  5. Dumps the CLI structure for a given command, process address
  6. or task address
  7. */
  8.  
  9. parse arg name '0x' tsk .
  10.  
  11. NULL = "00000000"x
  12.  
  13. if (name = '?') then
  14.    do
  15.    do i = 2 to 6
  16.       'd "'||strip(sourceline(i),'T',"0a"x) '"'
  17.    end
  18.    exit(0)
  19.    end
  20. else if (name ~= '') then
  21.    do
  22.    if datatype(name, 'W') then
  23.       do
  24.       clinum = name
  25.       name = 'Process' name
  26.       end
  27.    else
  28.       cliname = name
  29.    end
  30. else if (tsk ~= '') then
  31.    do
  32.    name = right(tsk,8,'0')
  33.    taskbase = x2c(name)
  34.    name = '0x'||name
  35.    end
  36. else
  37.    do
  38.    options results
  39.    'd a7 %08x'
  40.    sp = left(result,8)
  41.    'tasks'
  42.    tasklist = result
  43.    options
  44.  
  45.    /* Now figure out where the stack pointer should be */
  46.    sp = c2x(offset(x2c(sp),-118))
  47.  
  48.    place = index(tasklist,sp)
  49.    if (place = 0) then place = 87
  50.    name = substr(tasklist, place-33, 8)
  51.    taskbase = x2c(name)
  52.    name = '0x'||name
  53.  
  54.    end
  55.  
  56.  
  57. /* Show all CLI tasks */
  58. dosbase = findlib("dos.library")
  59. rootnode = import(offset(dosbase,34),4)
  60. tasktable = d2c(c2d(import(rootnode,4))*4,4)
  61. taskcount = c2d(import(tasktable,4))
  62. do tasknum = 1 to taskcount
  63.    proc = import(offset(tasktable,tasknum*4),4)
  64.  
  65.    if (proc ~= NULL) then
  66.       do
  67.       proc = offset(proc,-92)
  68.       cli = d2c(c2d(import(offset(proc,172),4))*4,4)
  69.       command = 'No command loaded'
  70.       module = ''
  71.       if (cli ~= NULL) then
  72.          do
  73.          cmdname = d2c(c2d(import(offset(cli,16),4))*4,4)
  74.          cmdlen = c2d(import(cmdname, 1))
  75.          module = import(offset(cmdname,1), cmdlen)
  76.          if cmdlen ~= 0 then
  77.             command = 'Loaded as command:' module "0x"||c2x(proc)
  78.          end
  79.       if (proc = taskbase | module = cliname | tasknum = clinum) then
  80.          do
  81.          'd "Process' tasknum||':' command '"'
  82.          /* Now dump the CLI Structure */
  83.  
  84.          pbstr = d2c(c2d(import(offset(cli,24),4))*4,4)
  85.          prompt = import(offset(pbstr,1),c2d(import(pbstr,1)))
  86.          'd "Prompt     : \"' || prompt || '\""'
  87.  
  88.          cbstr = d2c(c2d(import(offset(cli,4),4))*4,4)
  89.          curdir = import(offset(cbstr,1),c2d(import(cbstr,1)))
  90.          'd "Currentdir : \"' || curdir || '\""'
  91.  
  92.          ebstr = d2c(c2d(import(offset(cli,36),4))*4,4)
  93.          execfile = import(offset(ebstr,1),c2d(import(ebstr,1)))
  94.          'd "ExecuteFile: \"' || execfile || '\""'
  95.  
  96.          rslt2 = right(c2d(import(cli,4)),8)
  97.          retc  = right(c2d(import(offset(cli,12),4)),8)
  98.          stack = c2d(import(offset(cli,52),4))*4
  99.          'd "Result2:   ' rslt2 '  ReturnCode:    ' retc '   Stack:' stack '"'
  100.  
  101.          faillev = right(c2d(import(offset(cli,20),4)),8)
  102.          interactive = "NONInteractive"
  103.          if (import(offset(cli,40),4) ~= NULL) then interactive = "Interactive   "
  104.          type = "Foreground"
  105.          if (import(offset(cli,44),4) ~= NULL) then type = "Background"
  106.          'd "FailLevel: ' faillev ' ' interactive '            ' type '"'
  107.  
  108.          stdin = '$'||c2x(d2c(c2d(import(offset(cli,28),4))*4,4))
  109.          curin = '$'||c2x(d2c(c2d(import(offset(cli,32),4))*4,4))
  110.          redir = ''
  111.          if (stdin ~= curin) then redir = '  <Redirected>'
  112.          'd "StdInput: ' stdin '  CurrentInput: ' curin redir'"'
  113.  
  114.          stdout = '$'||c2x(d2c(c2d(import(offset(cli,48),4))*4,4))
  115.          curout = '$'||c2x(d2c(c2d(import(offset(cli,56),4))*4,4))
  116.          redir = ''
  117.          if (stdin ~= curin) then redir = '  <Redirected>'
  118.          'd "StdOutput:' stdout '  CurrentOutput:' curout redir'"'
  119.  
  120.          seglist = '$'||c2x(d2c(c2d(import(offset(cli,60),4))*4,4))
  121.          path    = '$'||c2x(d2c(c2d(import(offset(cli,8),4))*4,4))
  122.          'd "Seglist:  ' seglist '  Path:         ' path '"'
  123.          exit(0)
  124.          end
  125.       end
  126. end
  127. 'd "Unable to find' name '"'
  128. exit(0)
  129.  
  130. /* Find a given library in the system */
  131. findlib:
  132. parse arg tofind
  133. execbase = import("00000004"x,4)
  134. liboff = 378
  135. nodebase = import(offset(execbase, liboff), 4)
  136.  
  137. do while(import(nodebase,4) ~= NULL)
  138.    if import(import(offset(nodebase,10),4)) = tofind then return nodebase
  139.    nodebase = import(nodebase,4)
  140. end
  141.  
  142. 'd "Could not find' tofind||'"'
  143. exit(0)
  144.